Load Libraries

library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5     v purrr   0.3.4
## v tibble  3.1.6     v dplyr   1.0.7
## v tidyr   1.1.4     v stringr 1.4.0
## v readr   2.1.1     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(tidytuesdayR)
library(here)
## here() starts at C:/Users/Danielle Barnas/Documents/Repositories/Tidy_Tuesday
library(patchwork)
library(scales)
## 
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
## 
##     discard
## The following object is masked from 'package:readr':
## 
##     col_factor
library(ggrepel)
library(PNWColors)
library(hrbrthemes)
## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.
##       Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and
##       if Arial Narrow is not on your system, please see https://bit.ly/arialnarrow
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
rm(list=ls())

Bring in Data

breed_traits <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/breed_traits.csv')
## Rows: 195 Columns: 17
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr  (3): Breed, Coat Type, Coat Length
## dbl (14): Affectionate With Family, Good With Young Children, Good With Othe...
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.

Process for Heatmap

breed_traits <- breed_traits %>%
  # Only keep numeric variables
  select(-c('Coat Type',
            'Coat Length')) %>%
  pivot_longer(cols = 2:15, names_to = 'RankType', values_to = 'Ranking')


## Subset dogs by groups

retriever <- breed_traits %>%
  filter(grepl("Retriever",Breed)) %>%
  mutate(set = 'Retrievers') %>%
  mutate(text = paste0("Breed: ",Breed, "\n",RankType,": ", Ranking))
terrier <- breed_traits %>%
  filter(grepl("Terrier",Breed)) %>%
  mutate(set = 'Terriers') %>%
  mutate(text = paste0("Breed: ",Breed, "\n",RankType,": ", Ranking))
hound <- breed_traits %>%
  filter(grepl("hound",Breed)|grepl("Hound",Breed)|grepl("hund",Breed)) %>%
  mutate(set = 'Hounds') %>%
  mutate(text = paste0("Breed: ",Breed, "\n",RankType,": ", Ranking))
shepherd <- breed_traits %>%
  filter(grepl("heep",Breed)|grepl("hepherd",Breed)|grepl("Cattle",Breed)) %>%
  mutate(set = 'Shepherds') %>%
  mutate(text = paste0("Breed: ",Breed, "\n",RankType,": ", Ranking))
spaniel <- breed_traits %>%
  filter(grepl("Spaniel",Breed)) %>%
  mutate(set = 'Spaniels') %>%
  mutate(text = paste0("Breed: ",Breed, "\n",RankType,": ", Ranking))


# sequentially remove to observe remaining breeds as I subset
other<-breed_traits %>%
  filter(!grepl("Retriever", Breed)) %>%
  filter(!grepl("Terrier",Breed)) %>%
  filter(!grepl("hound",Breed)&!grepl("Hound",Breed)&!grepl("hund",Breed)) %>%
  filter(!grepl("heep",Breed)&!grepl("hepherd",Breed)&!grepl("Cattle",Breed)) %>%
  filter(!grepl("Spaniel",Breed))

# View remaining breeds
#dother<-other %>% distinct(Breed)

sub_breeds <- retriever %>%
  rbind(shepherd,
        spaniel)

Graph in plotly

pretriever <- ggplot(retriever,
                     aes(x = RankType,
                         y = Breed,
                         fill = Ranking, text=text)) +
  geom_tile() +
  scale_fill_gradient(low="#a4e8e0", high="#2f5061") +
  theme_ipsum() +
  #theme(axis.text.x = element_text(angle = 35, vjust = 0.5, hjust=1)) +
  theme(axis.text.x = element_blank()) +
  labs(title = "Retrievers")
p1 <- ggplotly(pretriever, tooltip="text")


pshepherd <- ggplot(shepherd,
                   aes(x = RankType,
                       y = Breed,
                       fill = Ranking, text=text)) +
  geom_tile() +
  scale_fill_gradient(low="#a4e8e0", high="#2f5061") +
  theme_ipsum() +
  #theme(axis.text.x = element_text(angle = 35, vjust = 0.5, hjust=1)) +
  theme(axis.text.x = element_blank())+
  labs(title = "Shepherds")
p2 <- ggplotly(pshepherd, tooltip="text")


pspaniel <- ggplot(spaniel,
                   aes(x = RankType,
                       y = Breed,
                       fill = Ranking, text=text)) +
  geom_tile() +
  scale_fill_gradient(low="#a4e8e0", high="#2f5061") +
  theme_ipsum() +
  theme(axis.text.x = element_text(angle = 35, vjust = 0.5, hjust=1)) +
  labs(title = "Spaniels")
p3 <- ggplotly(pspaniel, tooltip="text")

# subplot(p2, p3, p4, p5, p1, nrows=3,
#         heights = c(0.4, 0.3, 0.3)) # dimensions must add to 1

subplot(p1, p2, p3, nrows = 3) %>%
        layout(title = list(text = "Ranking Some Good Bois"))

Alternative plot in heatmap

library(superheat)

sub_breeds <- sub_breeds %>%
  select(-c(set,text)) %>%
  pivot_wider(names_from = RankType,
              values_from = Ranking) %>%
  column_to_rownames(var = 'Breed')

superheat(sub_breeds,
          scale = F,
          # add row dendrogram
          row.dendrogram = TRUE,
          # add text matrix
          X.text = round(as.matrix(sub_breeds), 1),
          X.text.col = "white",
          X.text.size = 4,
          # change the angle of the label text
          bottom.label.text.angle = 90,
          left.label.text.alignment = "left",
          bottom.label.text.alignment = "right",
          # change the size of the label text
          left.label.text.size = 3,
          bottom.label.text.size = 3,
          # change the color (#d8a7b1 = rosewater, teal and #05445e = navy)
          heat.pal = c("#d8a7b1", "#29a0b1", "#05445e"))